home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / gfxfx / stretch.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-10  |  2KB  |  90 lines
  1.  
  2. program strectch;
  3. uses crt;
  4. const
  5. {$i explorer.inc}
  6.   vidseg:word=$a000;
  7.   diffsin:array[0..63] of byte=(
  8.     0,0,1,1,2,2,3,3,4,4,5,5,6,6,5,5,4,4,3,3,
  9.     4,4,5,5,4,4,4,3,3,3,2,2,2,1,1,1,2,2,2,3,
  10.     3,3,4,4,3,3,2,2,1,1,0,0,0,1,1,2,3,4,3,2,1,1,0,0
  11.  
  12.    {0,0,0,1,0,1,1,2,1,2,2,3,2,3,3,4,3,4,4,5,
  13.     4,5,5,4,5,4,4,3,4,3,3,2,3,2,2,1,2,1,1,0,
  14.     1,0,0,0,0,1,2,2,3,3,3,4,4,4,4,3,3,3,2,2,1,0,0,0});
  15. var
  16.   f:text;
  17.   txt:array[0..99] of string[20];
  18.   bitmap:array[0..40,0..159] of byte;
  19.   virscr:pointer;
  20.   virseg:word;
  21.  
  22. procedure setvideo; assembler; asm
  23.   mov ax,13h; int 10h; mov dx,3d4h; mov al,9; out dx,al; inc dx
  24.   in al,dx; and al,0e0h; add al,3; out dx,al; end;
  25.  
  26. procedure setpal(col,r,g,b:byte); assembler; asm
  27.   mov dx,03c8h; mov al,col; out dx,al; inc dx; mov al,r
  28.   out dx,al; mov al,g; out dx,al; mov al,b; out dx,al; end;
  29.  
  30. procedure cls(lvseg:word); assembler; asm
  31.   mov es,[lvseg]; xor di,di; xor ax,ax; mov cx,320*200/2; rep stosw; end;
  32.  
  33. procedure flip(src,dst:word); assembler; asm
  34.   push ds; mov ax,[dst]; mov es,ax; mov ax,[src]; mov ds,ax
  35.   xor si,si; xor di,di; mov cx,320*200/2; rep movsw; pop ds; end;
  36.  
  37. procedure retrace; assembler; asm
  38.   mov dx,3dah; @vert1: in al,dx; test al,8; jz @vert1
  39.   @vert2: in al,dx; test al,8; jnz @vert2; end;
  40.  
  41. procedure setpalette;
  42. var c:word; i:byte;
  43. begin
  44.   c:=0;
  45.   for i:=0 to 255 do begin
  46.     setpal(i,pal[c],pal[c+1],pal[c+2]);
  47.     inc(c,3);
  48.   end;
  49. end;
  50.  
  51. procedure putpicture;
  52. var
  53.   bcka:array[0..156] of byte;
  54.   x,y,idx1,idx2,offset,add,col:word;
  55. begin
  56.   offset:=0; idx1:=0; idx2:=40; add:=0;
  57.   repeat
  58.     add:=0;
  59.     for y:=0 to 40 do begin
  60.       offset:=diffsin[(y+idx1+idx2) and $3f];
  61.       if offset>0 then begin
  62.         inc(add,offset);
  63.         for x:=0 to 156 do begin
  64.           col:=pic[y*157+x]; col:=col+col*256;
  65.           memw[virseg:(add+diffsin[(idx1+idx2+x) and $3f])*320+x+x]:=col;
  66.         end;
  67.       end;
  68.     end;
  69.     retrace;
  70.     flip(virseg,vidseg);
  71.     cls(virseg);
  72.     inc(idx1); dec(idx2,2);
  73.     {move(pic,bcka,157);
  74.     move(pic[157],pic,40*157);
  75.     move(bcka,pic[40*157],157);}
  76.   until keypressed;
  77. end;
  78.  
  79. begin
  80.   setvideo;
  81.   setpalette;
  82.   getmem(virscr,64000);
  83.   virseg:=seg(virscr^);
  84.   cls(virseg);
  85.   putpicture;
  86.   repeat until keypressed;
  87.   freemem(virscr,64000);
  88.   textmode(lastmode);
  89. end.
  90.